
module ProyectoIII(
	obtenerFrecuencia,
	crearRama,
	crearHuffman,
	generarAsociaciones,
	reconstruirHuffman,
	codificar,
	decodificar,
	Huffman
)
where

import Fib
import Data.List

data Huffman a = Hoja Integer a | Rama Integer (Huffman a) (Huffman a) deriving (Show)


-- Se establece cuando dos arboles de huffman son iguales y cuando son distintos
instance Eq (Huffman a) where
	(Hoja x _) == (Hoja y _) = (x == y)
	(Rama x _ _) == (Rama y _ _) = (x == y)
	(Hoja x _) == (Rama y _ _) = (x == y)

	(Hoja x _) /= (Hoja y _) = (x /= y)
	(Rama x _ _) /= (Rama y _ _) = (x /= y)
	(Hoja x _) /= (Rama y _ _) = (x /= y)

-- Se hacen las operaciones de orden
instance Ord(Huffman a) where
	(Hoja x _) < (Hoja y _) = (x < y)
	(Hoja x _) < (Rama y _ _) = (x < y)
	(Rama x _ _) < (Rama y _ _) = (x < y)
	(Rama x _ _) < (Hoja y _) = (x < y)
	
	(Hoja x _) <= (Hoja y _) = (x <= y)
	(Hoja x _) <= (Rama y _ _) = (x <= y)
	(Rama x _ _) <= (Rama y _ _) = (x <= y)
	(Rama x _ _) <= (Hoja y _) = (x <= y)
	
	(Hoja x _) > (Hoja y _) = (x > y)
	(Hoja x _) > (Rama y _ _) = (x > y)
	(Rama x _ _) > (Rama y _ _) = (x > y)
	(Rama x _ _) > (Hoja y _) = (x > y)
	
	(Hoja x _) >= (Hoja y _) = (x >= y)
	(Hoja x _) >= (Rama y _ _) = (x >= y)
	(Rama x _ _) >= (Rama y _ _) = (x >= y)
	(Rama x _ _) >= (Hoja y _) = (x >= y)


{-
 - Obtiene la frecuencia acumulada que se encuentra en la raiz del Arbol de
 - Huffman suministrado.
 -}
obtenerFrecuencia :: (Ord a) => Huffman a -> Integer
obtenerFrecuencia (Hoja n a) = n 
obtenerFrecuencia (Rama n a1 a2) = n 

{-
 - A partir de dos Arboles de Huffman, crea un nuevo  ́arbol que los tiene
 - como hijos. La frecuencia acumulada del nuevo  ́arbol es la suma de la de
 - los nuevos hijos.
 -}
crearRama :: (Ord a) => Huffman a -> Huffman a -> Huffman a
crearRama (Hoja n a) (Hoja m b) = Rama (n+m) (Hoja n a) (Hoja m b)
crearRama (Hoja n a) (Rama m b1 b2) = Rama (n+m) (Hoja n a) (Rama m b1 b2)
crearRama (Rama n a1 a2) (Hoja m b) = Rama (n+m) (Rama n a1 a2) (Hoja m b)
crearRama (Rama n a1 a2) (Rama m b1 b2) = Rama (n+m) (Rama n a1 a2) (Rama m b1 b2)

{-
 - Dado una lista que contiene un conjunto de simbolos y su cantidad de
 - ocurrencias, construye un Arbol de Huffman que la represente.
 -}

crearHuffman :: (Ord a) => [(a, Integer)] -> Huffman a
crearHuffman l = findMin(crearHuffmanAux (fromList(transformar l)))
  where
	transformar :: (Ord a) => [(a, Integer)] -> [Huffman a]
	transformar l = [Hoja b a | (a,b) <- l]

-- hay que mejorar la eficiencia de esto
-- recibe un Heap de fibonacci
--crearHuffmanAux :: (Ord a) => Fib.FibHeap (Huffman a) -> Fib.FibHeap (Huffman a)
crearHuffmanAux h
	| (tamano h)  == 1 = h
	| otherwise = crearHuffmanAux (insertFib (deleteMin(deleteMin(h))) (crearRama (findMin(h))  (findMin(deleteMin(h)))))
-- 	| otherwise = crearHuffmanAux (insert (deleteMin(deleteMin(h))) (crearRama (findMin(deleteMin(h))) (findMin(h)) ))


{-
 - Dado un Arbol de Huffman, devuelve una lista de tuplas con el conjunto de
 - todos los simbolos ocurrentes en el arbol, junto a la codificacion binaria
 - de los mismos (La lista de booleanos representa la lista de bits de la
 - codificacion, donde False representa el cero y True el uno).
 -}

generarAsociaciones :: Huffman a -> [(a,[Bool])]
generarAsociaciones a = obtenerSimbolos a []  
  where
  obtenerSimbolos :: Huffman a -> [Bool] -> [(a,[Bool])]
  obtenerSimbolos (Hoja _ a) l = [(a,l ++ [True])] 
  obtenerSimbolos (Rama _ izq der) l = (obtenerSimbolos izq (l ++ [False])) ++ (obtenerSimbolos der (l ++ [True]))

{- 
 - Dada una lista de tuplas con un conjunto de simbolos, junto a una codificacion 
 - binaria de los mismos construye un Arbol de Huffman tal que dichas asociaciones 
 - pudieran haber sido generadas. 
 -}

reconstruirHuffman :: (Ord a) => [(a, [Bool])] -> Huffman a
reconstruirHuffman l = reconstruirHuffmanAux (transformar l)
  where
  reconstruirHuffmanAux l
    | length(obtenerIzquierdo l) == 1 && length(obtenerDerecho l) > 1  = crearRama (fst(head(obtenerIzquierdo l))) (reconstruirHuffmanAux(obtenerDerecho l))
    | length(obtenerIzquierdo l)  > 1 && length(obtenerDerecho l) == 1 = crearRama (reconstruirHuffmanAux(obtenerIzquierdo l)) (fst(head(obtenerDerecho l)))
    | length(obtenerIzquierdo l) == 1 && length(obtenerDerecho l) == 1 = crearRama (fst(head(obtenerIzquierdo l))) (fst(head(obtenerDerecho l)))
    | length(obtenerIzquierdo l) >  1 && length(obtenerDerecho l) >  1 = crearRama (reconstruirHuffmanAux(obtenerIzquierdo l)) (reconstruirHuffmanAux(obtenerDerecho l))
    | length(l) == 1 = fst(head(l))

  obtenerDerecho :: [(a, [Bool])] -> [(a, [Bool])]
  obtenerDerecho l = [(x,ys) | (x,True:ys) <-l]

  obtenerIzquierdo :: [(a, [Bool])] -> [(a, [Bool])]
  obtenerIzquierdo l = [(x,ys) | (x,False:ys) <-l]

  transformar :: [(a,[Bool])] -> [(Huffman a,[Bool])]
  transformar l = [(Hoja 0 x, y) | (x,y) <- l ]

-- reconstruirHuffman [('a',[False,True]),('b',[True,False,True]),('c',[True,True,True])]
-- reconstruirHuffman [('o',[False,False,True]),('h',[False,True,True]),('l',[True,False,True]),('s',[True,True,False,True]),('a',[True,True,True,True])]
-- transformar [('a',[False,True]),('b',[True,False,True]),('c',[True,True,True])]


{-
 - Dado una lista de simbolos, devuelve una tupla. Esta tupla tiene como
 - primer elemento el Arbol de Huffman generado a partir de la lista de
 - simbolos dada. Como segundo elemento, tiene una lista donde cada uno
 - de los simbolos en la entrada, ha sido reemplazado por su representacion
 - binaria y concatenados para formar una sola cadena.
 -}
codificar :: (Ord a) => [a] -> (Huffman a, [Bool])
codificar cadena = (crearHuffman(cadenaApares cadena), foldl1 (++) (map obtenerCodificacion cadena))
  where
 --FALTA FIRMA
  obtenerCodificacion elem  = transformar (lookup elem (generarAsociaciones(crearHuffman(cadenaApares cadena))))

  transformar :: Maybe a -> a
  transformar (Just a) = a


-- Transforma una cadena de caracteres a una lista 
-- de tuplas (elem, ocurrencia)
cadenaApares :: (Eq a) => [a] -> [(a,Integer)]
cadenaApares cadena = nub [(x, toInteger(length(filter (==x) cadena)))| x <- cadena]

{-
 - Dado un Arbol de Huffman y luego una lista que representa a una cadena
 - de bits, devuelve una lista de simbolos que corresponde a la decodificacion
 - de dicha cadena con la informacion del arbol.
 -}
decodificar :: Huffman a -> [Bool] -> [a]
decodificar h l = recorrer h [] l 
  where
    recorrer :: Huffman a -> [a] -> [Bool] -> [a]
    recorrer h listCaract resto 
      | (length resto /= 0) =  decodificarAux h resto listCaract h 
      | otherwise = listCaract 

    decodificarAux :: Huffman a -> [Bool] -> [a] -> Huffman a -> [a]
    decodificarAux (Hoja _ a) (x:xs) l arbOrg
      |  (x == True) = recorrer arbOrg (l ++ [a]) xs
      | otherwise = error "decodoficacion incorrecta"

    decodificarAux (Rama _ izq der) (x:xs) l arbOrg
      | (x == True) = decodificarAux der xs l arbOrg
      | otherwise = decodificarAux izq xs l arbOrg






-- crearHuffman (cadenaApares "este es un ejemplo de un arbol de huffman")
-- crearHuffman [('e',7),('s',2),('t',1),(' ',8),('u',3),('n',3),('j', 1),('m',2),('p',1),('l',2),('o',2),('d',2),('a',2),('r',1),('b',1),('h',1),('f',2)]

	
-- crearHuffman [('f',5),('r', 3),('a',1),('b',2),('h',10),('i',5)]

-- findMin (crearHuffman [('f',5),('r', 3),('a',1),('b',2),('h',10),('i',5)])
-- fromList[Hoja 5 'f',Hoja 3 'r',Hoja 1 'a',Hoja 2 'b',Hoja 10 'h',Hoja 5 'i']



--Main> codificar "hola"
--(Rama 4 (Rama 2 (Hoja 1 'o') (Hoja 1 'h')) (Rama 2 (Hoja 1 'a') (Hoja 1 'l')),[False,True,True,False,False,True,True,True,True,True,False,True])




--reconstruirHuffman [('a',[True,True]),('b',[False,True]),('c',[True,True,True])] 
